'##################################################
'###  Top Level (Get root Path from system env)
'##################################################
function GetEnv(envVarName)
	On Error Resume Next
	' 创建Shell对象并获取值
	Set WshShell = CreateObject("WScript.Shell")
	envValue = WshShell.Environment("PROCESS")(envVarName) ' 优先查找进程级变量

	' 如果未找到则尝试系统级变量
	If Err.Number <> 0 Or envValue = "" Then
		Err.Clear
		envValue = WshShell.Environment("SYSTEM")(envVarName)
	End If

	' 如果仍未找到则尝试用户级变量
	If Err.Number <> 0 Or envValue = "" Then
		Err.Clear
		envValue = WshShell.Environment("USER")(envVarName)
	End If

	' 检查结果并输出
	If Err.Number = 0 And envValue <> "" Then
		GetEnv=envValue
	Else
		GetEnv=""
	End If
end function

'##################################################
'##################################################
'##################################################
sub IncludeVbs(filepath)
	Dim fso, file, content
	Set fso = CreateObject("Scripting.FileSystemObject")
	' 读取functions.vbs的内容
	Set file = fso.OpenTextFile(filepath, 1) ' 1表示只读
	content = file.ReadAll
	file.Close
	' 将functions.vbs的内容载入全局作用域
	ExecuteGlobal content
end sub

'##################################################
'##################################################
'##################################################
dim root,tmpfile
Dim doc
Set doc = application.ActiveDocument
main
set doc = nothing
sub main()

	'on error resume next
	'// REUSE
	envVarName ="EXP_SHORTCUTS_ROOT"
	root = GetEnv(envVarName)'"C:\MentorGraphics\2005EXP\SDD_HOME\pvtk\env\"
	if root ="" then 
		msgbox "please set env value (EXP_SHORTCUTS_ROOT = ?)"
		exit sub
	end if
	call IncludeVbs(root & "\skill_lib.vbs")
	
	If ValidateServer(doc) = 0 Then
	    msgbox "Server validation failed."
	    exit sub
	End If	
	
	'// TODO
	dim dict
	set dict = createobject("scripting.dictionary")
	
	dim selnet
	'selnet = GetClipboardText_fm20
	dim tmppin,tmppins
	set tmppins = doc.pins(0)
	
	for each tmppin in tmppins
		if tmppin.highlighted=true then
			selnet=tmppin.net.name
			dict.add tmppin.component.name,""
			'exit for
		end if		
	next

	if selnet = "(Net0)" or selnet = "GND" or selnet = "" then
		msgbox "wrong net selected!1"
		exit sub
	end if
	set netobj = doc.findnet(selnet)
	if netobj is nothing then 
		msgbox "wrong net selected!2"
		exit sub
	end if
	
	'application.gui.processkeyin "pr -dist *"
	dim x,y
	x = doc.Activeview.MousePositionX
	y = doc.Activeview.MousePositionY
	dim cmp	
	dim pcbpin,pcbpins
	set pcbpins = netobj.pins(0)
	dim pref
	dim selref
	dim selyr
	dim ret
	dim ncount:ncount=0
	for each pcbpin in pcbpins
		if pcbpin.highlighted = false then
			set cmp = pcbpin.component
			selref=pcbpin.component.name
			if dict.Exists(selref) = false then
				pref = left(selref,1)
				if pref ="C" or pref="L" or pref ="R" then
					ret = IsRouted(pcbpin.positionX,pcbpin.PositionY,pcbpin.layer)
					if ret = false then
						on error resume next
						cmp.Anchor =0
						call cmp.move(x,y,0)
						ncount = ncount+1
					end if 	
				else
					'msgbox cmp.name
					cmp.Anchor =0
					call cmp.move(x,y,0)
					ncount = ncount+1
				end if
				
				dict.add selref,""
			end if		
		end if		
	next
	
	if ncount = 0 then msgbox "none!"	
	dict.removeall
	set dict = nothing	
	
	if ncount>0 then application.gui.activemode = 0
end sub
function IsRouted(x,y,lyr)
	dim ret :ret = false
	dim layerObj,layerObjColl
	Set layerObj = application.Utility.NewLayerObject
    layerObj.ConductorLayer = lyr
	Set layerObjColl = application.Utility.NewLayerObjects
    layerObjColl.Add layerObj


	dim ob,obs
	dim delta:delta = 0
	Set obs = doc.Pick(x - delta, y - delta, x + delta, y + delta,1 or 2, layerObjColl, True, True, 0)
	If (Not obs Is Nothing) Then
		For Each ob In obs				
			'msgbox ob.ObjectClass
			'ob.highlighted = true
			If ob.ObjectClass = 1 then
				if ob.issmd = false then
					ret = true 
					exit for
				end if
			end if	
			If ob.ObjectClass = 2 Then 
				on error resume next
				if ob.type2=20 then ret = true:exit for
			End If
		Next			          
	end if
	
	checkroute = ret	
end function